00100	C******* SUBRS  TAIL, FERMTA, REST, BREP, EXCH, SORT2, NOZERO,
00200		SUBROUTINE TAIL
00300		COMMON/ALF/INP(49),RMINI,RINV,RA,RX,RJX,NONO(19)
00400		COMMON /STF/RSTFAC(8),RSTJ2 /PLTR/IPLT,RHT,DIS
00500		DIMENSION ITAIL(16)
00600		DATA ITAIL/16,100090007,110012,120016,200120016,120019,100026,
00700		1 80030,20036, 40, 33, 30031, 50029,80025,100022,120016/
00800		CALL CENTER(RJY)
00900		Q=-1.
01000		IF(RA)Q=1.
01100		IF(IPLT)GO TO 2
01200		ITAIL(1)=10
01300	1	CALL JDRAW(ITAIL,RJX,RJY,RMINI,1.,Q)
01400		RETURN
01500	2	P=Q
01600		IF(RMINI.NE.RSTJ2)P=P*.6
01700		ITAIL(1)=16
01800		CALL FILLMS(12,ITAIL(5),RJX,RJY,ABS(P),P)
01900	C RA=-,STEM UP;  RA=+, STEM DOWN.
02000		GO TO 1
02100		END
02200	
02300		SUBROUTINE REST
02400		COMMON /STF/RSTFAC(8),RSTJ2/PLTR/IPLT,RHT,DIS
02500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
02600		EQUIVALENCE(J5,JQ(3)),(R3,RJQ(1)),(R4,RJQ(2)),(R7,RJQ(5))
02700		1,(R6,RJQ(4)),(R8,RJQ(6)),(R5,RJQ(3)),(R10,RJQ(8)),(J4,JQ(2))
02800		1,(R9,RJQ(7)),(RA,JQ(4)),(RB,JQ(5))
02900		DIMENSION LRST(3),IRST(47),MR(2),MF(2)
03000		DATA IRST/9,100000033,160033,160030, 30,32 ,160032 ,160031,
03100		1 31,  23,100000051,100038,32,110017,200050044, 32 ,50026,
03200		1 100038,50044,100110017,70018,50017,50015,60011, 10016,
03300		1 18,  20,10022,30023, 50023, 70022,110017,
03400		1 15,100030033, 40032, 80032,120035,150039,70014,200010037,
03500		1 30039, 50039, 70037, 70035, 50033, 30033,10035/
03600		1,LRST/1,10,33/,MR/18,8/,MF/15,40/
03700	C  LRST = BEGINNING OF EACH REST, MR=FILLER WDCNT, MF=FILL START.
03800	
03900		L=J5
04000		IF(L.GT.1)L=1
04100		IF(L)L=-1
04200	C  L>3 WHEN SEVERAL TAILS ON REST
04300		R10=RSTJ2
04400		IF(IABS(J4).LT.80)GO TO 2
04500	C NEXT FOR MINI-RESTS
04600		RSTJ2=RSTJ2*.7
04700		J4=0
04800		R4=R4+2.
04900	2	CALL CENTER(CENTR)
05000		RA=1.
05100		RB=R3
05200		IF(J5.NE.-3)GO TO 9
05300	C  -3 IN P5 = DOUBLE WHOLE REST.
05400		J5=-5
05500		RA=2.
05600		RB=RB-8*RSTJ2
05700	C TO CENTER THE DOUBLE WHOLE REST.
05800	9	IF(J5.LE.-2)CENTR=CENTR+9.4*R10
05900	C  CENTERS WHOLE REST
06000	5	CALL JDRAW(IRST(LRST(L+2)),RB,CENTR,RSTJ2,RA,1.)
06100		IF(J5.GT.-3)GO TO 4
06200		J5=J5+1
06300		CENTR=CENTR-3.133*R10
06400		GO TO 5
06500	4	IF(J5.GE.0)GO TO 6
06600	CHECK FOR NEED OF LEDGER LINES (1/2 AND WHOLE RESTS)(NOT FOR DBLS).
06700		RA=5
06800		RB=-5
06900		CENTR=CENTR+29*RSTJ2
07000		IF(J5.EQ.-1)GO TO 8
07100		CENTR=CENTR+5*RSTJ2
07200		RA=3
07300		RB=-7
07400	C THESE FOR WHOLE RESTS.  ABOVE FOR 1/2.
07500	8	IF(R4.GE.RA)GO TO 7
07600		IF(R4.GT.RB)GO TO 6
07700	7	IF(R9.NE.0)GO TO 6
07800	C  P9≠0 SUPRESSES LEDGER LINE.
07900		RA=R3-7*RSTJ2
08000		RB=R3+22*RSTJ2
08100		CALL LINX(RA,CENTR,RB,CENTR)
08200	
08300	6	IF(IPLT.GE.0)GO TO 1
08400		IF(J5)GO TO 1
08500		L=L+1
08600		CALL FILLMS(MR(L),IRST(MF(L)),R3,CENTR,1.,1.)
08700	C  WHY GO THROUGH NOTWRT??
08800	1	IF(R8.EQ.0)RETURN
08900	C  TO PUT NUM OVER REST - MULTIPLE BARS.(R8=-1 =NO NUM. OVER WHOLE RST)
09000		R4=R4+10.6
09100	C HEIGHT ??
09200		IF(IPLT)GO TO 3
09300		R6=5.96*R6
09400	C  USE PARAM 6 TO CHANGE SIZE OF CENTERING AID LINE.
09500		IF(R6.EQ.0)R6=55.
09600		CALL LINX(R3-R6,CENTR,R3+R6+16.0*RSTJ2,CENTR)
09700	C  HORIZ. LINE FOR CENTERING ON DPY ONLY.  WILL NOT PRINT!
09800	C  NEXT IS J3 
09900	3	JQ(1)=ROFF(R3+8.*RSTJ2)
10000		R5=R8
10100		R6=1.5
10200	C  NUMBER SIZE
10300		R8=0
10400	C  ↑↑↑↑↑ ALL THIS BECAUSE OF PARAM NUMS IN MAKNUM AND NOTWRT
10500		R7=0
10600	C  FOR BDR40 FONT
10700		IF(R5.GT.0)CALL MAKNUM(R5)
10800		J5=0
10900		R7=0
11000	C  ↑↑↑↑↑ NEEDED??
11100		END
11200	
11300	C  READS DATA 
11400	C  FOR SINGLE (OR DOUBLE) BAR REPEAT SIGN
11500		SUBROUTINE BREP
11600		DIMENSION IREP(35)
11700		COMMON R2,JA,CENTR,J2,R3,RJQ(39) /STF/RSTFAC(8),RSTJ2
11800		DATA IREP/35,100000015,280043,290043, 10015, 20015, 300043,310043
11900		1,30015, 40015, 320043,100020037, 30038, 40038, 50037
12000		1,50036, 40035, 30035, 20036, 20037, 50037, 20036, 40036
12100		1,100270022,280021,290021,300022,300023,290024,280024,270023
12200		1,270022, 300022, 270023, 290023/
12300		CALL CENTER(R)
12400		CALL JDRAW(IREP,R3,R,RSTJ2,1.,1.)
12500		END
12600	
12700		SUBROUTINE FERMTA
12800		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
12900		COMMON /PLTR/IPLT,RHT,DIS /ALF/INP(49),RMINI,RINV,NO(22)
13000		EQUIVALENCE(J5,JQ(3)),(R4,RJQ(2)),(R7,RJQ(5)),(ISTEM,JQ(20))
13100		1,(R6,RJQ(4)),(R8,RJQ(6)),(R3,RJQ(1))
13200		1,(R9,RJQ(7)),(RA,JQ(4)),(RX4,JQ(19))
13300		DIMENSION JFERM(45)
13400		DATA JFERM/24,310020003,10010010,20015,60017,110017,160015,
13500		1 190010,200003,170010,150012,120014,70014,30012,10010,
13600		1 10020003,100070007,80008,100008,110007,110006,100005,80005
13700		1 ,70006, 20,100081006, 80012,  90012,  91006, 110030002, 30008,
13800		1 70002,130008,170002, 200005, 200170002,141001,100005,130008,
13900		1 170002, 100070002, 41001, 5, 30008, 70002/
14000	
14100	C  22-25, 27-29 AVAILABLE YET.  (3/76)
14200		IF(J5.NE.21)GO TO 6
14300	C  NEXT FOR HEAVY WEDGE ACCENT
14400		J5=44
14500	C  TO BE FOUND IN 'CLEF4.DMD'
14600		R6=1
14700		RA=1.8
14800		IF(ISTEM.EQ.1)R7=-1
14900	C 2= STEM DOWN
15000	 	IF(R7)RA=-7.7
15100		R4=RX4+RA
15200		R8=0
15300		R9=0
15400		CALL CLEFS
15500		RETURN
15600	6	IF(RINV.LT.17)GO TO 1
15700		JFERM(29)=16
15800		JFERM(35)=210005
15900		IF(RINV.NE.17)GO TO 2
16000		JFERM(29)=91006
16100		J=25
16200		GO TO 4
16300	2	JFERM(29)=16
16400	C  FOR INVERTED MORDANT
16500		J=29
16600	4	RINV=1.
16700		GO TO 3
16800	1	J=1
16900	3	CALL JDRAW(JFERM(J),R3,CENTR,RMINI,1.,RINV)
17000		IF(IPLT.GE.0)RETURN
17100		IF(J.EQ.1)GO TO 5
17200		J=35
17300		JFERM(35)=10
17400	5	CALL FILLMS(JFERM(J),JFERM(J+1),R3,CENTR,1.,RINV)
17500		END
17600	
17700	CC	SUBROUTINE EXCH(X,Y)
17800	CC	Z=X
17900	CC	X=Y
18000	CC	Y=Z
18100	CC	END
18200	CF	SUBROUTINE SORT2(RPOS,M)
18300	CF	DIMENSION RPOS(2,200)
18400	CF	L=2
18500	CF3	J=-1
18600	CF	RX=RPOS(1,L-1)
18700	CF	DO 2 K=L,M
18800	CF	IF(RPOS(1,K).GE.RX)GO TO 2
18900	CF	RX=RPOS(1,K)
19000	C   WHY WERE ALL THE RX'S  JX ????? 9/6/73
19100	CF	J=K
19200	CF2	CONTINUE
19300	CF	IF(J)GO TO 4
19400	CF	K=L-1
19500	CF	CALL EXCH(RPOS(1,K),RPOS(1,J))
19600	CF	CALL EXCH(RPOS(2,K),RPOS(2,J))
19700	CF4	L=L+1
19800	CF	IF(L.LE.M)GO TO 3
19900	CF	END
20000	
20100	CC	SUBROUTINE NOZERO(X)
20200	CC	IF(X.EQ.0)X=1
20300	CC	END
20400	
20500		SUBROUTINE PNUM
20600		COMMON R2,JA,CENTR,J2,R3,R4,R5,R6,RJQ(16),J3,J4,J5,J6,J7,
20700		1 J10J,IPUNC,DONT,RXX,RX,JQ(10) /STF/RSTFAC(-3/4),RSTJ2
20800		DIMENSION NUMQ(44),RNUMS(341)
20900		COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
21000		DATA RACNT/4.0,1000.005,17.0,0.105, 8.0,1003.0, 7.014, 11.0
21100		1,13. ,1000. ,0.010,14.01,14. ,17. ,1001.018,7. ,13.018,27.,
21200		1 1004., 4.002, 6.004, 8.004,10.002,10., 8.102,6.102,4.
21300		1,32.0,1000.0,14.0,1007.007,7.107, 43.0,1012.01,11.006,9.003
21400		1, 7.001, 5.0, 9.002, 13.006, 15.01, 10.004, 13.009, 52.0,
21500		1 1002.008,3.003, 5.001, 8.0, 10.0, 13.001, 15.003, 16.008,
21600		1 65.,1106.104, 0.002, 6.104, 12.002, 18.104, 24.002, 24.003,
21700		1 18.103, 12.003, 6.103, 0.003, 106.103/
21800	     1 ,RNOTE/ 1000., 5.007, 11.007, 16., 11.107, 5.107, 0.0,
21900	     1 1000.0, 7.007, 14.0, 7.107, 0,  1000.107, 14.007,
22000	     1 1014.107,0.007, 1000.003,4.107,6.007,9.107,11.007,14.103/
22100		DATA RDOT/1000.101, .102, 1.103, 2.103, 3.102, 3.101, 2., 1.,
22200		1 .101, 2.103, 2., .102, 3.102, 1., 1.103, 3.101, .102/
22300		1 ,XAC/9,14,18,28,33,44,53/
22400	C   ALL DATA NUMS OVER 90 GIVE INVISIBLE VECTORS
22500		DATA RACCI/6.0,1115.003, 110.007, 106.001,
22600	     1 115.109, 115.021, 15.0, 1104.104, 118.108,
22700	     1 1108.113, 108.016,  1104.008, 118.004,
22800	     1 1114.014, 114.115, 22.0,1106.117, 106.007, 114.004
22900	     1, 1114.018, 114.107, 106.104/
23000	     1 ,NACCI/1,7,16/
23100		DATA
23200	     1 NUMQ/1,11,15,23,33,38,47,57,62,79, 89,95,108,117,125,132,138
23300	     1,150,157,164,171,177,181,187,1,192,200,212,221,234,239,246
23400	     1,250,256,261,266,  271,282,285,293,298,314,330,335/
23500	      DATA (RNUMS(K),K=1,131)/10.0,1003.107, 6.102, 6.01, 3.015,
23600	     1 104.015, 107.01,107.102, 104.107, 3.107,
23700	     1 14.0, 1105.011, 101.015, 101.107, 22.0,
23800	     1 1106.011, 102.015, 3.015, 7.011, 7.005, 107.107, 7.107, 32.0,
23900	     1 1107.015, 7.015, 101.007, 3.007, 7.003, 7.102, 3.107, 103.107,
24000	     1 107.103, 37.0, 1007.102, 107.102, 2.015, 2.107, 46.0, 1107.107,
24100	     1 4.103, 7.0, 7.004, 2.006, 107.004, 107.015, 7.015, 56.0,
24200	     1 1004.015, 107.0, 107.103, 103.107, 4.107, 7.103, 7.0, 3.003,
24300	     1 104.003, 61.0, 1107.011, 107.015, 7.015, 107.107, 78.0, 1003.004,
24400	     1 7.0, 7.103, 4.107, 104.107, 107.103, 107.0, 103.004, 3.004,
24500	     1 6.008, 6.012, 2.015, 102.015, 106.012, 106.008, 103.004,
24600	     1 88.0, 1104.107, 7.008, 7.011, 4.015, 104.015, 107.011, 107.008,
24700	     1 103.005, 4.005, 94.0, 1106.107, 0.015,6.107,1004.101,104.101,
24800	     1 107.0, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 1106.004,
24900	     1 2.004, 6.001, 6.104, 3.107, 106.107, 116.0, 1006.104, 3.107,
25000	     1 103.107, 106.104, 106.011, 103.015, 3.015, 6.011, 124.0,
25100	     1 1106.107, 106.015, 3.015, 6.011, 6.103, 3.107, 106.107,
25200	     1 131.0, 1006.107, 106.107, 106.015, 6.015, 1003.005, 106.005/
25300	C   THE NEXT IS FOR 'F' TO 'P'
25400	C   1 NUM NOT NEEDED IN 'G'  ALSO IN RNOTE (1/2 NOTE).
25500	      DATA (RNUMS(K),K=132,199)/
25600	     1 137.0, 1106.107, 106.015, 6.015, 1003.005, 106.005, 149.0, 
25700	     1 1001.102, 6.102, 6.104, 6.104, 3.107, 103.107, 106.104, 
25800	     1 106.011, 103.015, 3.015, 6.011, 156.0, 1106.107, 106.015,
25900	     1 1006.015, 6.107, 1006.005, 106.005, 163.0, 1106.107, 0.107,
26000	     1 1103.107, 103.015, 1106.015, 0.015,
26100	     1 170.0, 1110.102, 110.105, 108.107, 103.107, 101.105, 101.015, 
26200	     1 176.0, 1106.107, 106.015, 1006.015, 106.005, 6.107, 180.0,
26300	     1 1006.107, 106.107, 106.015, 186.0, 1106.107, 106.015, 1.004,
26400	     1 8.015, 8.107, 191.0, 1106.107, 106.015, 6.107, 6.015, 199.0
26500	     1, 1106.107, 106.015, 3.015, 6.012, 6.007, 3.004, 106.004/ 
26600	C   'Q' TO ')'
26700	      DATA(RNUMS(K),K=200,341)/
26800	     1 211.0, 1003.107, 6.102, 6.01, 3.015, 103.015, 106.01, 106.102,
26900	     1 103.107, 3.107, 1001.001, 7.108, 220.0, 1106.107, 106.015,
27000	     1 3.015, 6.012, 6.007, 3.004, 106.004, 6.107, 233.0, 1106.104,
27100	     1 103.107, 3.107, 6.104, 6.001, 3.004, 103.004, 106.007, 106.011,
27200	     1 103.015, 3.015, 6.01, 238.0, 1106.015, 7.015, 1000.015, 0.107,
27300	     1 245.0, 1106.015, 106.104, 103.107, 3.107, 6.104, 6.015, 249.0,
27400	     1 1106.015, 0.107, 6.015, 255.0, 1106.015, 103.107, 1.005, 5.107,
27500	     1 8.015, 260.0, 1106.015, 6.107, 1106.107, 6.015, 265.0, 1106.015,
27600	     1 0.003, 1106.107, 6.015, 270.0, 1106.015, 6.015, 106.107, 6.107,
27700	     1 281.0, 1105.102, 105.105,103.105,104.102,104.105,105.102,103.102,
27800	     1103.108, 106.112, 1106.112, 284., 1110.003, 2.003, 292., 1105.102,
27900	     1 105.105,104.102,104.105,103.102,103.105,105.102,297.0,1110.007,
28000	     1 2.007, 1110.0, 2.0, 313.0, 1101.015, 103.013, 105.010,
28100	     1 106.006,106.002,105.102,103.105,101.107, 103.104,104.102,105.002
28200	     1 ,105.006,104.01,103.012,101.015, 329.0,1107.015,105.013,
28300	     1 103.01 ,102.006,102.002,103.102,105.105,107.107, 105.104,104.102
28400	     1 ,103.002,103.006,104.01,105.012,107.015,  334.0,1110.003,
28500	     1 2.003, 1104.009, 104.103,  341.0,1110.004, 2.004, 1101.009,
28600	     1 107.101, 1101.101, 107.009/
28700	C  3RD ITEM IN 19400 NOT NEEDED 12/73
28800	C  1-10=NUMS 0-9, 11-36=ALPHA, 37-42=SIGNS
28900	
29000		CALL CENTX
29100		J10J=J5
29200		CALL NOZERO(R6)
29300		SIZ=R6*RSTJ2
29400		IPUNC=0
29500		IF(J10J.LT.44)GO TO 451
29600		IPUNC=J10J
29700		IF(J10J.EQ.44)J10J=38
29800		IF(J10J.GE.45)J10J=36
29900		IF(J5.NE.46)GO TO 451
30000		RXX=4
30100		CALL RJBX(-RXX)
30200		RX=16
30300		CENTR=CENTR+RX*SIZ
30400	451	IX=NUMQ(J10J+1)
30500	C  IX=END # OF ITEM
30600	C  IX+1=1ST PART OF ITEM
30700	      CALL RDRAW(IX+1,RNUMS(IX),RNUMS,SIZ,R3,CENTR+RSTJ2*3.,SIZ)
30800		IF(IPUNC.EQ.0)RETURN
30900		IF(IPUNC.NE.46)GO TO 351
31000		CALL RJBX(SIZ*2.*RXX)
31100	C  FOR "
31200	651	IPUNC=0
31300		GO TO 451
31400	351	RXX=11
31500	C FOR : AND ;
31600		CENTR=CENTR+RXX*SIZ
31700		J10J=38
31800		GO TO 651
31900		END